Pascal Super Library/Pascal Super Library (CW International)(1997).bin/LIBRARY/PAS_0693/DIGITAL.PAS

Pascal/Delphi Source File | 1993-06-30 | 16KB | 490 lines

{─ Fido Pascal Conference ────────────────────────────────────────────── PASCAL ─
Msg  : 583 of 587
From : David Dahl                          1:272/38.0           06 Jun 93  02:45
To   : All
Subj : [1/2] Sound Playing Routines
────────────────────────────────────────────────────────────────────────────────
        I've gotten tired of writing these routines and have gone
on to other projects so I don't have time to work on them now.  I
figured others may get some use out of them though.  They're not
totally done yet, but what is there does work (as far as I can
tell).  They support playing digitized sound (signed or unsigned)
at sample rates from 18hz to 44.1khz (at least on my 386sx/25),
on the PC Speaker (polled), LPT DACs (1-4) or Adlib FM channels.
I was planning on adding Sound Blaster DAC, Gravis UltraSound,
and PC Speaker (pulse width modulated) support.  I also planned
on adding VOC support.  I may add those at a later date, but no
promises.  I'll release any new updates (if there are any)
through the PDN since these routines are a little long (this will
be the ONLY post of these routines in this echo).  I haven't
tested the LPT DAC routines, so could someone who has an LPT DAC
please test them and let me know if they work?  (They SHOULD
work, but you never know.)  These routines work for me under
Turbo Pascal V6.0 on my 386sx/25.}

Unit Digital;
(*************************************************************************)
(*                                                                       *)
(*  Programmed by David Dahl                                             *)
(*  This Unit and all routines are PUBLIC DOMAIN.                        *)
(*                                                                       *)
(*  Special thanks to Emil Gilliam for information (and code!) on Adlib  *)
(*  digital output.                                                      *)
(*                                                                       *)
(*  If you use any of these routines in your own programs, I would       *)
(*  appreciate an acknowledgement in the docs and/or program... and I'm  *)
(*  sure Mr. Gilliam wouldn't object to having his name mentioned, too.  *)
(*                                                                       *)
(*************************************************************************)
Interface

Const BufSize       = 2048;

Type  BufferType = Array[1 .. BufSize] of Byte;
      BufPointer = ^BufferType;

      DeviceType = (LPT1, LPT2, LPT3, LPT4, PcSpeaker, PCSpeakPW,
                    Adlib, SoundBlaster, UltraSound);

Var   DonePlaying : Boolean;

Procedure SetOutPutDevice (DeviceName    : DeviceType;
                           SignedSamples : Boolean    );
Procedure SetPlaySpeed    (Speed : LongInt);

Procedure PlayRAWSoundFile (FileName   : String;
                            SampleRate : Word   );
Function  LoadBuffer       (Var F    : File;
                            Var BufP : BufPointer) : Word;
Procedure PlayBuffer       (BufPtr : BufPointer;
                            Size   : Word       );

Procedure HaltPlaying;
Procedure CleanUp;

Implementation

Uses CRT;

Const C8253ModeControl   = $43;
      C8253Channel       : Array[0..2] of Byte = ($40, $41, $42);
      C8253OperatingFreq = 1193180;

      C8259Command       = $20;

      TimerInterrupt     = $08;

      AdlibIndex         = $388;
      AdlibReg           = $389;

Type  ZeroAndOne = 0 .. 1;

Var   DataLength  : Word;
      Buffer      : BufPointer;

      LPTAddress  : Word;
      LPTPort     : Array[1 .. 4] of Word Absolute $0040:$0008;

      OldTimerInterrupt : Pointer;

      InterruptVector   : Array[0..255] of Pointer Absolute $0000:$0000;

{=[ Misc Procedures ]=====================================================}
{-[ Clear Interrupt Flag (Disable Maskable Interrupts) ]------------------}
Procedure CLI;
Inline($FA);
{-[ Set Interrupt Flag ]--------------------------------------------------}
Procedure STI;
Inline($FB);
{=[ Initialize Sound Devices ]============================================}
{-[ Initialize Adlib FM For Digital Output ]------------------------------}
Procedure InitializeAdlib;

Var TempInt : Pointer;

  Procedure Adlib (Reg, Data : Byte); Assembler;
  Asm
     mov  dx, AdlibIndex            { Adlib index port }
     mov  al, Reg

     out  dx,al                     { Set the index }

     { Wait for hardware to respond }
     in al,dx; in al,dx; in al,dx; in al,dx; in al,dx; in al,dx

     inc  dx                        { Adlib register port }
     mov  al, Data
     out  dx,al                     { Set the register value }

     dec  dx                        { Adlib index port }

     { Wait for hardware to respond }
     in al,dx; in al,dx; in al,dx; in al,dx; in al,dx
     in al,dx; in al,dx; in al,dx; in al,dx; in al,dx
     in al,dx; in al,dx; in al,dx; in al,dx; in al,dx
     in al,dx; in al,dx; in al,dx; in al,dx; in al,dx
     in al,dx; in al,dx; in al,dx; in al,dx; in al,dx
     in al,dx; in al,dx; in al,dx; in al,dx; in al,dx
     in al,dx; in al,dx; in al,dx; in al,dx; in al,dx

  End;

Begin
     Adlib ($00, $00);    { Set Adlib test Register }
     Adlib ($20, $21);    { Operator 0: MULTI=1, AM=VIB=KSR=0, EG=1 }
     Adlib ($60, $F0);    { Attack = 15, Decay = 0 }
     Adlib ($80, $F0);    { Sustain = 15, Release = 0 }
     Adlib ($C0, $01);    { Feedback = 0, Additive Synthesis = 1 }
     Adlib ($E0, $00);    { Waveform = Sine Wave }
     Adlib ($43, $3F);    { Operator 4: Total Level = 63, Attenuation = 0 }
     Adlib ($B0, $01);    { Fnumber = 399 }
     Adlib ($A0, $8F);
     Adlib ($B0, $2E);    { FNumber = 143, Key-On }

{   Wait for the operator's sine wave to get to top and then stop it there
    That way, we have an operator who's wave is stuck at the top, and we can
    play digitized sound by changing it's total level (volume) register. }

    Asm
       mov  al,0                      { Get timer 0 value into DX }
       out  43h,al
       jmp  @Delay1

    @Delay1:
       in   al,40h

       mov  dl,al
       jmp  @Delay2

    @Delay2:
       in   al,40h

       mov  dh,al
       sub  dx,952h                   { Target value }

       @wait_loop:
         mov  al,0                    { Get timer 0 value into BX }
         out  43h,al
         jmp  @Delay3

       @Delay3:
         in   al,40h

         mov  bl,al
         jmp  @Delay4

       @Delay4:
         in   al,40h

         mov  bh,al
         cmp  bx,dx                   { Have we waited that much time yet? }
       ja   @wait_loop                { If no, then go back }

    End;

{   Now that the sine wave is at the top, change its frequency to 0 to keep
    it from moving  }

    Adlib ($B0, $20);  { F-Number = 0 }
    Adlib ($A0, $00);  { Frequency = 0 }

    Port [AdlibIndex] := $40;
End;
{=[ Sound Device Handlers ]===============================================}
Procedure PlayPCSpeaker; Interrupt;
Const Counter : Word = 1;
Begin
     If Not(DonePlaying) Then
     Begin
          If Counter <= DataLength Then
          Begin
               Port[$61] := (Port[$61] AND 253) OR
                            ((Buffer^[Counter] AND 128) SHR 6);

               Counter := Counter + 1;
          End
          Else
          Begin
               DonePlaying := True;
               Counter     := 1;
          End;
     End;

     Port[C8259Command] := $20; { Enable Interrupts }
End;

Procedure PlayPCSpeakerSigned; Interrupt;
Const Counter : Word = 1;
Begin
     If Not(DonePlaying) Then
     Begin
          If Counter <= DataLength Then
          Begin
               Port[$61] := (Port[$61] AND 253) OR
                            ((byte(shortint(Buffer^[Counter]) + 128) AND
                            128) SHR 6);

               Counter := Counter + 1;
          End
          Else
          Begin
               DonePlaying := True;
               Counter     := 1;
          End;
     End;

     Port[C8259Command] := $20; { Enable Interrupts }
End;

Procedure PlayLPT; Interrupt;
Const Counter : Word = 1;
Begin
     If Not(DonePlaying) Then
     Begin
          If Counter <= DataLength Then
          Begin
               Port[LPTAddress] := Buffer^[Counter];

               Counter := Counter + 1;
          End
          Else
          Begin
               DonePlaying := True;
               Counter     := 1;
          End;
     End;

     Port[C8259Command] := $20; { Enable Interupts }
End;

Procedure PlayLPTSigned; Interrupt;
Const Counter : Word = 1;
Begin
     If Not(DonePlaying) Then
     Begin
          If Counter <= DataLength Then
          Begin
               Port[LPTAddress] := byte(shortint(Buffer^[Counter]) + 128);

               Counter := Counter + 1;
          End
          Else
          Begin
               DonePlaying := True;
               Counter     := 1;
          End;
     End;

     Port[C8259Command] := $20; { Enable Interupts }
End;

Procedure PlayAdlib; Interrupt;
Const Counter : Word = 1;
Begin
     If Not(DonePlaying) Then
     Begin
          If Counter <= DataLength Then
          Begin
               Port[AdlibReg] := (Buffer^[Counter] SHR 2);
               Counter := Counter + 1;
          End
          Else
          Begin
               DonePlaying := True;
               Counter     := 1;
          End;
     End;

     Port[C8259Command] := $20; { Enable Interupts }
End;

Procedure PlayAdlibSigned; Interrupt;
Const Counter : Word = 1;
Begin
     If Not(DonePlaying) Then
     Begin
          If Counter <= DataLength Then
          Begin
               Port[AdlibReg] := byte(shortint(Buffer^[Counter]) + 128)
                                 SHR 2;
               Counter := Counter + 1;
          End
          Else
          Begin
               DonePlaying := True;
               Counter     := 1;
          End;
     End;

     Port[C8259Command] := $20; { Enable Interupts }
End;
{=[ 8253 Timer Programming Routines ]=====================================}
Procedure Set8253Channel (ChannelNumber : Byte;
                          ProgramValue  : Word);
Begin
     Port[C8253ModeControl] := 54 OR (ChannelNumber SHL 6); { XX110110 }
     Port[C8253Channel[ChannelNumber]] := Lo(ProgramValue);
     Port[C8253Channel[ChannelNumber]] := Hi(ProgramValue);
End;
{-[ Set Clock Channel 0 (INT 8, IRQ 0) To Input Speed ]-------------------}
Procedure SetPlaySpeed (Speed : LongInt);
Var ProgramValue : Word;
Begin
     ProgramValue := C8253OperatingFreq DIV Speed;

     Set8253Channel (0, ProgramValue);
End;
{-[ Set Clock Channel 0 Back To 18.2 Default Value ]----------------------}
Procedure SetDefaultTimerSpeed;
Begin
     Set8253Channel (0, 0);
End;
{=[ File Handling ]=======================================================}
{-[ Load Buffer With Data From Raw File ]---------------------------------}
Function LoadBuffer (Var F    : File;
                     Var BufP : BufPointer) : Word;
Var NumRead : Word;
Begin
     BlockRead (F, BufP^, BufSize, NumRead);

     LoadBuffer := NumRead;
End;
{=[ Sound Playing / Setup Routines ]======================================}
{-[ Output Sound Data In Buffer ]-----------------------------------------}
Procedure PlayBuffer (BufPtr : BufPointer;
                      Size   : Word       );
Begin
     Buffer      := BufPtr;
     DataLength  := Size;
     DonePlaying := False;
End;
{-[ Halt Playing ]--------------------------------------------------------}
Procedure HaltPlaying;
Begin
     DonePlaying := True;
End;

{=[ Initialize Data ]=====================================================}
Procedure InitializeData;
Const CalledOnce : Boolean = False;
Begin
     If Not(CalledOnce) Then
     Begin
          DonePlaying       := True;
          OldTimerInterrupt := InterruptVector[TimerInterrupt];
          CalledOnce        := True;
     End;
End;
{=[ Set Interrupt Vectors ]===============================================}
{-[ Set Timer Interrupt Vector To Our Device ]----------------------------}
Procedure SetOutPutDevice (DeviceName    : DeviceType;
                           SignedSamples : Boolean);
Begin
     CLI;

     Case DeviceName of
          LPT1 .. LPT4 : Begin
                              LPTAddress := LPTPort[Ord(DeviceName)];
                              If SignedSamples Then
                                 InterruptVector[TimerInterrupt] :=
                                                              @PlayLPTSigned
                              Else
                                 InterruptVector[TimerInterrupt] := @PlayLPT;
                         End;
          PCSpeaker    : If SignedSamples Then
                            InterruptVector[TimerInterrupt] :=
                                                        @PlayPCSpeakerSigned
                         Else
                            InterruptVector[TimerInterrupt] :=
                                                        @PlayPCSpeaker;
          Adlib        : Begin
                              InitializeAdlib;

                              If SignedSamples Then
                                 InterruptVector[TimerInterrupt] :=
                                                            @PlayAdlibSigned
                              Else
                                 InterruptVector[TimerInterrupt] :=
                                                            @PlayAdlib;
                         End;
     Else
         Begin
            STI;

            Writeln;
            Writeln ('That Sound Device Is Not Supported In This Version.');
            Writeln ('Using PC Speaker In Polled Mode Instead.');

            CLI;
            If SignedSamples Then
               InterruptVector[TimerInterrupt] := @PlayPCSpeakerSigned
            Else
               InterruptVector[TimerInterrupt] := @PlayPCSpeaker;
         End;
     End;
     STI;
End;
{-[ Set Timer Interupt Vector To Default Handler ]------------------------}
Procedure SetTimerInterruptVectorDefault;
Begin
     CLI;

     InterruptVector [TimerInterrupt] := OldTimerInterrupt;

     STI;
End;

Procedure PlayRAWSoundFile (FileName   : String;
                            SampleRate : Word);
Var RawDataFile : File;
    SoundBuffer : Array[ZeroAndOne] of BufPointer;
    BufNum      : ZeroAndOne;
    Size        : Word;
Begin
     New(SoundBuffer[0]);
     New(SoundBuffer[1]);

     SetPlaySpeed (SampleRate);

     Assign (RawDataFile, FileName);
     Reset  (RawDataFile, 1);

     BufNum := 0;

     Size := LoadBuffer (RawDataFile, SoundBuffer[BufNum]);

     PlayBuffer (SoundBuffer[BufNum], Size);

     While Not(Eof(RawDataFile)) do
     Begin
          BufNum := (BufNum + 1) AND 1;

          Size := LoadBuffer (RawDataFile, SoundBuffer[BufNum]);

          Repeat Until DonePlaying;

          PlayBuffer (SoundBuffer[BufNum], Size);

     End;

     Close (RawDataFile);

     Repeat Until DonePlaying;

     SetDefaultTimerSpeed;

     Dispose (SoundBuffer[1]);
     Dispose (SoundBuffer[0]);
End;

{=[ MUST CALL BEFORE EXITING PROGRAM!!! ]=================================}
Procedure CleanUp;
Begin
     SetDefaultTimerSpeed;
     SetTimerInterruptVectorDefault;
End;
{=[ Set Up ]==============================================================}
Begin
     InitializeData;
     NoSound;
End.